# Coloured Petri Net (CPN): Place Class
# Release: Development
#
# Copyright (c) 2002 Torvald Riegel. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Copyright (c) 2011 Brent R. Scott. All rights reserved. This program has
# been modified from the original release and is free software. You can 
# redistribute it and/or modify it under the same terms as Perl itself.
#
# This class creates a Place object which contains the following attributes:
#  - Coloured tokens (Colour is pending).
#  - Reference to associated Petri Net.
#  - Name (optional)
#
# The name attribute, which is passed as parameter: name => STRING, is set at
# object instantiation. The other attributes are set and modified after the 
# object has been created. NOTE: If the net attribute is not set then the 
# object becomes stale.

package CPN::Place;

use strict;
use Data::Dumper;
use Carp;

sub new {
    my $type = shift;
    my $name = '';
    my $net  = undef;
    my $tokens = [];
    my %params = @_;
    $name   = $params{'name'}   if defined $params{'name'};
    $net    = $params{'net'}    if defined $params{'net'};
    $tokens = $params{'tokens'} if defined $params{'tokens'};
    return bless {
                  tokens=> $tokens,
                  name  => $name,
                  net   => $net,
                  arcs  => [],
                 }, $type;
}
sub destroy { 
	my $self = shift;
	printf("$self dying at %s\n", scalar localtime);
}

# Params: Reference to associated to Petri Net
# Used if the net attribe was not set when the place was created.
sub setNet {
    my $self = shift;
    $self->{net} = shift;
}

# Params: @Array of Tokens
# TODO: Make tokens coloured
sub addToken {
    my $self = shift;
    my @id;
    foreach (0..$#_) {
        unless (defined $self->{tokens}->[$_]) {
            $self->{tokens}->[$_] = shift;
            push @id, $_;
        }
    }
    
    my $size = @{$self->{tokens}};
    #push @{$self->{tokens}}, @_;
    #$self->{net}->tokenAdded($self, @id, $size..($size + @_ - 1))
    #  if $self->{net};
}

# Params: None
sub getAllTokens {
    my $self = shift;
    return (wantarray ? @{$self->{tokens}} : $self->{tokens});
}

# Params: @Array of Specific Tokens
# Returns: @Array of Specific Tokens
sub getTokens {
    my $self = shift;
    return (wantarray ? $self->{tokens}->[@_] : [$self->{tokens}->[@_]]);
}

# Params: Single Token ID
# Returns: Single Token
sub getToken {
    my $self = shift;
    return $self->{tokens}->[shift];
}

# Params: Array of Tokens
sub removeToken {
    my $self = shift;
    foreach (@_) {
        delete $self->{tokens}->[$_];
    }
    $self->{net}->tokenRemoved($self, @_)
      if $self->{net};
}

# TODO: Consumer/Producer State
# Outgoing arcs might add the consumer property, but only at the net level.

sub isProducer {
    return 1;
}

sub isConsumer {
    return 1;
}

1;
